home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Binaries / examples / asl / token.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  1.8 KB  |  73 lines  |  [TEXT/ttxt]
  1. (* $Id: token.ml,v 1.4 91/10/04 14:22:16 ddr Exp $ *)
  2.  
  3. #open "asl";;
  4.  
  5. let I x = x;;
  6.  
  7. let keywords =
  8.   let t = hashtbl__new 13 in
  9.   hashtbl__add t "else" ELSE;
  10.   hashtbl__add t "fi" FI;
  11.   hashtbl__add t "if" IF;
  12.   hashtbl__add t "let" LET;
  13.   hashtbl__add t "then" THEN;
  14.   t
  15. ;;
  16.  
  17. let buff = create_string 2000;;
  18.  
  19. (***
  20. let rec ident len = function
  21.   [<
  22.     '(`a`..`z` | `A` .. `Z` | `0` .. `9` | `_` | `'`) as c;
  23.     (set_nth_char buff len c; ident(succ len)) i
  24.   >] -> i
  25. | [< >] ->
  26.     let str = sub_string buff 0 len in
  27.     (try hashtbl__find keywords str with _ -> IDENT str)
  28. ;;
  29. ***)
  30.  
  31. let rec ident len = function
  32.   [< '(`a`..`z` | `A` .. `Z` | `0` .. `9` | `_` | `'`) as c; s >] ->
  33.     set_nth_char buff len c; ident (succ len) s
  34. | [< >] ->
  35.     let str = sub_string buff 0 len in
  36.     (try hashtbl__find keywords str with _ -> IDENT str)
  37. ;;
  38.  
  39. let rec number n = function
  40.   [< '`0` .. `9` as d; s >] ->
  41.     number(10*n+int_of_char d-int_of_char`0`) s
  42. | [< >] -> n
  43. ;;
  44.  
  45. let rec next_token = function
  46.   [< '(`a`..`z` | `A` .. `Z`) as c; s >] ->
  47.     set_nth_char buff 0 c; ident 1 s
  48. | [< '`0` .. `9` as d; s >] ->
  49.     INT(number (int_of_char d-int_of_char `0`) s)
  50. | [< '` ` | `\n` | `\t`; s >] -> next_token s
  51. | [< '`+` | `-` | `*` | `/` as c >] -> OP (make_string 1 c)
  52. | [< '`.` >] -> DOT
  53. | [< '`=` >] -> EQUAL
  54. | [< '`\\` >] -> BSLASH
  55. | [< '`;` >] -> SEMICOL
  56. | [< '`(` >] -> LPAREN
  57. | [< '`)` >] -> RPAREN
  58. | [< 'x >] -> failwith ("Bad char: "^make_string 1 x)
  59. ;;
  60.  
  61. let rec reset_lexer = function
  62.   [< '`\n` >] -> ()
  63. | [< '_; reset_lexer _ >] -> ()
  64. | [< >] -> ()
  65. ;;
  66.  
  67. let token_name = function
  68.   IDENT _ -> "IDENT" | INT _ -> "INT" | OP _ -> "OP"
  69. | BSLASH -> "\\" | DOT -> "." | ELSE -> "else" | EQUAL -> "="
  70. | FI -> "fi" | IF -> "if" | LET -> "let" | LPAREN -> "("
  71. | RPAREN -> ")" | SEMICOL -> ";" | THEN -> "then" 
  72. ;;
  73.